home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / PRUS101.ZIP / FCRT.PAS < prev    next >
Pascal/Delphi Source File  |  1994-12-19  |  39KB  |  1,132 lines
  1. UNIT FCRT; { FIDO unit to enhance and replace TP's CRT unit, screen handling }
  2.  (***************************************************************************
  3.  
  4.      RELEASE 1.14 - as first contained in the file PRUS101.LZH
  5.         by Orazio Czerwenka, 2:2450/540.55, GERMANY
  6.  
  7.            --------------------------------------------
  8.         organized for Fido's PASCAL related echoes    
  9.            --------------------------------------------
  10.  
  11.      05/14/1994 to 12/15/1994 by Orazio Czerwenka, 2:2450/540.55, GERMANY
  12.      12/15/1994 to --/--/---- by Paul Schubert,    2:244/1181.18, GERMANY
  13.  
  14.  
  15.        As far as third party copyrights are not violated this
  16.        source code is hereby placed to the public domain. Use
  17.        it whatever way you want, but use AT YOUR OWN RISK.
  18.  
  19.        In case you should modify the source rather send your
  20.        modifications to the unit's current organizer (see above for
  21.        NM address) than to spread it on your own. This will help to
  22.        keep the unit updated and grant a certain standard to all
  23.        other users as well.
  24.  
  25.        The unit is currently still under work. So it might greatly
  26.        benefit of your participation.
  27.  
  28.        Those who contributed to the following piece of source,
  29.        listed in alphabethical order:
  30.     ================================================================
  31.        Ralph Brown(interrupt listings), Orazio Czerwenka, Jens
  32.        Larsson, Max Maischein, Sean Palmer, Christian Proehl, Paul
  33.        Schubert(FCONDRV.INC), SWAG Support Team (hardware indepen-
  34.        dend delay) ...
  35.     ================================================================
  36.        YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.
  37.  
  38.        Special thanx to Paul Schubert who significantly enhanced
  39.        this unit by contributing an additional include file FCONDRV
  40.        to partially clone and improve CRT's screen related standard
  41.        routines.
  42.  
  43.        Credits in your own programs are as welcome as unnecessary.
  44.  
  45.  ***************************************************************************)
  46.  
  47. {$I FDEFINE.DEF} { Use the general include file for conditional defines and
  48.            common compiler directives ... }
  49.  
  50.          { ... and set the unit's specific defines aftwerwards. }
  51.  
  52. {$A+}            { A+ will slightly speed up some of the more important
  53.            source }
  54.  
  55. {$F+,R-,S-}
  56.  
  57. Interface
  58. USES
  59.   dos;
  60.  
  61. CONST
  62.  
  63.   { Don't yet rely on these colour constants, they have been implemented
  64.     only for usage by another unit currently under work but might well
  65.     cease to be included in future releases }
  66.  
  67.   BLACK     =   0; BLUE      =  16; GREEN     =  32; CYAN      =  48;
  68.   RED       =  64; MAGENTA   =  80; BROWN     =  96; LIGHTGRAY = 112;
  69.  
  70.  
  71.   PageFlipping : Boolean = TRUE;
  72.  
  73.   TEXTATTR       : BYTE = 7;
  74.   WINDMIN        : WORD = 0;
  75.   WINDMAX        : WORD = 6223;
  76.   DIRECTVIDEO    : BOOLEAN = TRUE;
  77.  
  78.  
  79. TYPE
  80.   NameStr       = STRING[8];
  81.   CursorShape   = RECORD top, bottom : byte; END;
  82.  
  83.  
  84.   { These routines are for internal use ONLY. In no way you should try to
  85.     mess around with it, if you'd like to keep your programs being capable
  86.     of getting compiled with further improved versions of this unit. }
  87.  
  88.   DisplayAtProc = Procedure(x,y:word;at:byte;s:string);
  89.  
  90.  
  91. var
  92.   VideoRAM         : word;                 { start address of video ram }
  93.   VideoPageSize    : word absolute $40:$4C;{ the size of an video page  }
  94.   CurrentVideoMode : Byte Absolute $40:$49;{ the mode currently in use  }
  95.  
  96.   StartVideoPage,                          { the page upon start }
  97.   StartVideoMode,                          { the mode upon start }
  98.   VisualVideoPage,                         { the page 'really' in foreground }
  99.   ActiveVideoPage,                         { used to store page to write on  }
  100.   MaxX, MaxY,
  101.  
  102.  
  103.  
  104.   { Don't yet rely on that on, it might perish in future releases as well. }
  105.  
  106.   LastVideoMode   : byte;
  107.  
  108.  
  109.   { These routines are for internal use ONLY. In no way you should try to
  110.     mess around with it, if you'd like to keep your programs being capable
  111.     of getting compiled with further improved versions of this unit. }
  112.  
  113.   OptDisplayAt    : DisplayAtProc;   {OptDisplay      : DisplayProc;}
  114.  
  115.  
  116. procedure InitFCRT;             { !!! Call prior to any other functions !!! }
  117. procedure ReInitFCRT;
  118.  
  119. procedure DisablePageFlipping;
  120. procedure EnablePageFlipping;
  121.  
  122. procedure EnableLightBackground (b:boolean);
  123. procedure SetBlinkBit (b:boolean);
  124. procedure ScrOn;
  125. procedure ScrOff;
  126.  
  127. function  GetVideoDisplayCode: Byte;
  128. function  GetCardStr: NameStr;
  129. function  VGACard: boolean;
  130. function  EGAAvail: boolean;
  131. function  VGAAvail: boolean;
  132. function  VGAMode: boolean;
  133. function  EGAMode: boolean;
  134.  
  135. function  GetVideoMode: word;
  136.  
  137. procedure SetVideoMode(mode: word);
  138.  
  139. procedure SetActiveVideoPage(page: byte);
  140. procedure SetVisualVideoPage(page: byte);
  141.  
  142. function  GetX: byte;                           
  143. function  GetY: byte;                           
  144. procedure SetScreenPos(x,y:byte);
  145.  
  146. procedure PutCharAttr(cha:char;attr:byte;nr:Word);     
  147. procedure CRLF;                                        
  148.  
  149. procedure Display(at:byte;s:string);
  150. procedure DisplayLn(at:byte;s:string);                 
  151. procedure DisplayAt(x,y:word;at:byte;s:string);
  152.  
  153. (*{$F+}*)
  154.  
  155.    { These routines are basically for the units internal use and will
  156.      possibly be changed. So don't use'em directly by now, or extract'em
  157.      to a personal unit of yours. There is no guarantee yet that they will
  158.      be included in future releases also. }
  159.  
  160. procedure StdDisplay(at:byte;s:string);
  161. procedure StdDisplayAt(x,y:word;at:byte;s:string);
  162. procedure QuickDisplay(at:byte;s:string);
  163. procedure QuickDisplayAt(x,y:word;at:byte;s:string);
  164. procedure FastDisplayAt(x,y:word;at:byte;s:string);
  165.  
  166. (*{$F-}*)
  167.  
  168. procedure CursorRight(m:byte);
  169. procedure CursorLeft(m:byte);
  170. procedure CursorUp(m:byte);
  171. procedure CursorDown(m:byte);
  172. procedure SaveCursorShape(VAR CurShape:CursorShape);
  173. procedure RestoreCursorShape(CurShape:CursorShape);
  174. procedure SetCursorShape (FirstLine, LastLine : byte);
  175.  
  176. procedure HideCursor;
  177. procedure NormCursor;
  178. procedure BoxCursor;
  179. procedure MinCursor;
  180.  
  181. procedure ColourBox (x,y,xx,yy,at:byte);
  182. procedure ColourColumn (x,y,yy,at:byte);
  183. procedure ColourRow (x,y,xx,at:byte);
  184. procedure ClearBox (x,y,xx,yy,at:byte);
  185.  
  186.  
  187. procedure Delay(ms : Word);
  188.  
  189. { window related operations }
  190. procedure ClrScr;
  191. procedure GotoXY(x,y:Byte);
  192. function  WhereX:Byte;
  193. function  WhereY:Byte;
  194. procedure Window(x,y,xx,yy:Byte);
  195. procedure ClrEoL;
  196.  
  197. procedure AssignFCRT (var F : Text);
  198. { AssignFCRT() works similar to AssignCRT to return to FCRT
  199.   output after having its output reassigned }
  200.  
  201. { non-window related operations to address the screen
  202.   absolutely }
  203. procedure ClrScrAbsolute;
  204. procedure GotoXYAbsolute(x,y:Byte);
  205. function  WhereXAbsolute:Byte;
  206. function  WhereYAbsolute:Byte;
  207.  
  208.  
  209. { don't use yourself the following routines by now, they
  210.  still need to be significantly modified }
  211. procedure PushWindow;
  212. procedure PopWindow;
  213. procedure ClrEoS;
  214. { clear to end of screen }
  215.  
  216.  
  217. Implementation
  218.  
  219. var
  220.   ch               : char;
  221.   w,CRTC           : word;
  222.   i                : integer;
  223.  
  224. {$I FCONDRV.INC}
  225.  
  226. { ************************************************************************** }
  227. { ╒════════════════════════════════════════════════════════════════════════╕ }
  228. { │ SetCursorShape (FirstLine , LastLine : byte)                           │ }
  229. { ╘════════════════════════════════════════════════════════════════════════╛ }
  230. procedure SetCursorShape (FirstLine , LastLine : byte); assembler;
  231. { Original author: Orazio Czerwenka }
  232. ASM
  233.   MOV   CH,FirstLine                    { set top scan line }
  234.   MOV   CL,LastLine                     { set bottom scan line }
  235.   MOV   AH,01h                          { set text mode cursor shape }
  236.   INT   10h                             { call int 10h }
  237. end;
  238.  
  239.  
  240. { ************************************************************************** }
  241. { ╒════════════════════════════════════════════════════════════════════════╕ }
  242. { │ HideCursor                                                             │ }
  243. { ╘════════════════════════════════════════════════════════════════════════╛ }
  244. procedure HideCursor;                   { tested for VGA }
  245. { Original author: Orazio Czerwenka }
  246. begin
  247.   SetCursorShape($FF,$FF);                   { top & bottom to line 256 }
  248. end;
  249.  
  250.  
  251. { ************************************************************************** }
  252. { ╒════════════════════════════════════════════════════════════════════════╕ }
  253. { │ NormCursor                                                             │ }
  254. { ╘════════════════════════════════════════════════════════════════════════╛ }
  255. procedure NormCursor;                   { tested for VGA }
  256. { Original author: Orazio Czerwenka }
  257. begin
  258.   SetCursorShape($06,$07);
  259. end;
  260.  
  261.  
  262. { ************************************************************************** }
  263. { ╒════════════════════════════════════════════════════════════════════════╕ }
  264. { │ BoxCursor                                                              │ }
  265. { ╘════════════════════════════════════════════════════════════════════════╛ }
  266. procedure BoxCursor;                    { tested for VGA }
  267. { Original author: Orazio Czerwenka }
  268. begin
  269.   SetCursorShape($01,$07);
  270. end;
  271.  
  272.  
  273. { ************************************************************************** }
  274. { ╒════════════════════════════════════════════════════════════════════════╕ }
  275. { │ MinCursor                                                              │ }
  276. { ╘════════════════════════════════════════════════════════════════════════╛ }
  277. procedure MinCursor;                    { tested for VGA }
  278. { Original author: Orazio Czerwenka }
  279. begin
  280.   SetCursorShape($07,$07);
  281. end;
  282.  
  283.  
  284. { ************************************************************************** }
  285. { ╒════════════════════════════════════════════════════════════════════════╕ }
  286. { │ SaveCursorShape (var CurShape : CursorShape)                           │ }
  287. { ╘════════════════════════════════════════════════════════════════════════╛ }
  288. procedure SaveCursorShape (var CurShape:CursorShape);
  289. { Original author: Orazio Czerwenka }
  290. var
  291.   regs  :       Registers;
  292. begin
  293.   Regs.AH:= $03;                        { get cursor size }
  294.   Regs.BH:= ActiveVideoPage;            { page number }
  295.   INTR($10,regs);                       { call int 10h }
  296.   with regs do begin
  297.     CurShape.top:=CH;                   { save top scan line }
  298.     CurShape.bottom:=CL;                { save bottom scan line }
  299.   end;
  300. end;
  301.  
  302.  
  303. { ************************************************************************** }
  304. { ╒════════════════════════════════════════════════════════════════════════╕ }
  305. { │ RestoreCursorShape (CurShape : CursorShape)                            │ }
  306. { ╘════════════════════════════════════════════════════════════════════════╛ }
  307. procedure RestoreCursorShape (CurShape:CursorShape);
  308. { Original author: Orazio Czerwenka }
  309. var
  310.   regs    :       Registers;
  311. begin
  312.   with regs do
  313.   begin
  314.     AH:= $01;                           { set text mode cursor shape }
  315.     CH:= CurShape.top;                  { restore top scan line }
  316.     CL:= CurShape.bottom;               { restore bottom scan line }
  317.     INTR($10,regs);                     { call int 10h }
  318.   end;
  319. end;
  320.  
  321.  
  322. { ************************************************************************** }
  323. { ╒════════════════════════════════════════════════════════════════════════╕ }
  324. { │ CursorRight (m : Byte)                                                 │ }
  325. { ╘════════════════════════════════════════════════════════════════════════╛ }
  326. procedure CursorRight(m:byte); assembler;
  327. { Original author: Orazio Czerwenka }
  328.   asm
  329.     mov  ah, 03h                        { get cursor position }
  330.     mov  bh, ActiveVideoPage            { page number }
  331.     int  10h
  332.     mov  ah, 02h                        { set cursor position }
  333.     mov  bh, ActiveVideoPage            { page number }
  334.     mov  al, m
  335.     add  al, dl
  336.     mov  dl, al
  337.     int  10h
  338.   end;
  339.  
  340.  
  341. { ************************************************************************** }
  342. { ╒════════════════════════════════════════════════════════════════════════╕ }
  343. { │ CursorLeft (m : Byte)                                                  │ }
  344. { ╘════════════════════════════════════════════════════════════════════════╛ }
  345. procedure CursorLeft(m:byte); assembler;
  346. { Original author: Orazio Czerwenka }
  347.   asm
  348.     mov  ah, 03h                        { get cursor position }
  349.     mov  bh, ActiveVideoPage            { page number }
  350.     int  10h
  351.     mov  cl, dl
  352.     mov  ah, 02h                        { set cursor position }
  353.     mov  bh, ActiveVideoPage            { page number }
  354.     mov  al, m
  355.     sub  al, cl
  356.     mov  dl, al
  357.     int  10h
  358.   end;
  359.  
  360. { ************************************************************************** }
  361. { ╒════════════════════════════════════════════════════════════════════════╕ }
  362. { │ CursorUp (m : Byte)                                                    │ }
  363. { ╘════════════════════════════════════════════════════════════════════════╛ }
  364. procedure CursorUp(m:byte); assembler;
  365. { Original author: Orazio Czerwenka }
  366.   asm
  367.     mov  ah, 03h                        { get cursor position }
  368.     mov  bh, ActiveVideoPage            { page number }
  369.     int  10h
  370.     mov  cl,  dh
  371.     mov  ah, 02h                        { set cursor position }
  372.     mov  bh, ActiveVideoPage            { page number }
  373.     mov  al, m
  374.     sub  al, cl
  375.     mov  dh, al
  376.     int  10h
  377.   end;
  378.  
  379. { ************************************************************************** }
  380. { ╒════════════════════════════════════════════════════════════════════════╕ }
  381. { │ CursorDown (m : Byte)                                                  │ }
  382. { ╘════════════════════════════════════════════════════════════════════════╛ }
  383. procedure CursorDown(m:byte); assembler;
  384. { Original author: Orazio Czerwenka }
  385.   asm
  386.     mov  ah, 03h                        { get cursor position }
  387.     mov  bh, ActiveVideoPage            { page number }
  388.     int  10h
  389.     mov  cl,  dh
  390.     mov  ah, 02h                        { set cursor position }
  391.     mov  bh, ActiveVideoPage            { page number }
  392.     mov  al, m
  393.     add  al, cl
  394.     mov  dh, al
  395.     int  10h
  396.   end;
  397.  
  398. { ************************************************************************** }
  399. { ╒════════════════════════════════════════════════════════════════════════╕ }
  400. { │ SetScreenPos ( x,y : Byte )                                            │ }
  401. { ╘════════════════════════════════════════════════════════════════════════╛ }
  402. procedure SetScreenPos (x,y:byte);  assembler;
  403. { Original author: Orazio Czerwenka }
  404. ASM
  405.   MOV   AH, 02h                          { set cursor position }
  406.   MOV   BH, ActiveVideoPage              { page number }
  407.   MOV   DL, x                            { column }
  408.   MOV   DH, y                            { row }
  409.   SUB   DX, 0101h                        { dec DH,DL }
  410.   INT   10h                              { call int 10h }
  411. end;
  412.  
  413. { ************************************************************************** }
  414. { ╒════════════════════════════════════════════════════════════════════════╕ }
  415. { │ PutCharAttr (cha : char; attr : byte; nr : Word)                       │ }
  416. { ╘════════════════════════════════════════════════════════════════════════╛ }
  417. procedure PutCharAttr(cha:char;attr:byte;nr:Word); assembler;
  418. { Original author: Orazio Czerwenka }
  419. asm
  420.   mov ah,09h                           { write character and attribute }
  421.   mov al,cha                           { character }
  422.   mov bh,ActiveVideoPage               { page number }
  423.   mov bl,attr                          { attribute }
  424.   mov cx,nr                            { number of times to write }
  425.   int 10h                              { call int 10h }
  426. end;
  427.  
  428.  
  429. { ************************************************************************** }
  430. { ╒════════════════════════════════════════════════════════════════════════╕ }
  431. { │ ColourBox (x,y,xx,yy,at : Byte)                                        │ }
  432. { ╘════════════════════════════════════════════════════════════════════════╛ }
  433. procedure ColourBox (x,y,xx,yy,at:byte);
  434. { Original author: Orazio Czerwenka }
  435. var
  436.   b1,
  437.   b2    :       byte;
  438.   regs  :       registers;
  439.   ch    :       char;
  440. begin
  441.   for b1:= x to xx do begin
  442.     for b2:= y to yy do begin
  443.       SetScreenPos(b1,b2);
  444.       with regs do begin
  445.     ah:= $08;                       { read character and attribute }
  446.     bh:= ActiveVideoPage;           { page number }
  447.     intr($10,regs);                 { call int 10h }
  448.     ch:= al;                        { save character }
  449.     PutCharAttr(chr(ord(ch)),at,1);
  450.       end;
  451.     end;
  452.   end;
  453. end;
  454.  
  455.  
  456. { ************************************************************************** }
  457. { ╒════════════════════════════════════════════════════════════════════════╕ }
  458. { │ ColourColumn (x,y,yy,at : Byte)                                        │ }
  459. { ╘════════════════════════════════════════════════════════════════════════╛ }
  460. procedure ColourColumn (x,y,yy,at:byte);
  461. { Original author: Orazio Czerwenka }
  462. var
  463.   b     :       byte;
  464.   ch    :       char;
  465.   regs  :       registers;
  466. begin
  467.   for b:= y to yy do begin
  468.     SetScreenPos(x,b);
  469.     With regs do begin
  470.       ah:= $08;                         { read character and attribute }
  471.       bh:= ActiveVideoPage;             { page number }
  472.       intr($10,regs);                   { call int 10h }
  473.       ch:= al;                          { save character }
  474.       PutCharAttr(chr(ord(ch)),at,1);   { change colour attribute }
  475.     end;
  476.   end;
  477. end;
  478.  
  479.  
  480. { ************************************************************************** }
  481. { ╒════════════════════════════════════════════════════════════════════════╕ }
  482. { │ ColourRow (x,y,xx,at : Byte)                                           │ }
  483. { ╘════════════════════════════════════════════════════════════════════════╛ }
  484. procedure ColourRow (x,y,xx,at:byte);
  485. { Original author: Orazio Czerwenka }
  486. var
  487.   b     :       byte;
  488.   ch    :       char;
  489.   regs  :       registers;
  490. begin
  491.   for b:= x to xx do begin
  492.     SetScreenPos(b,y);
  493.     with regs do begin
  494.       ah:= $08;                         { read character and attribute }
  495.       bh:= ActiveVideoPage;             { page number }
  496.       intr($10,regs);                   { call int 10h }
  497.       ch:= al;                          { save character }
  498.       PutCharAttr(chr(ord(ch)),at,1);   { change colour attribute }
  499.     end;
  500.   end;
  501. end;
  502.  
  503.  
  504. { ************************************************************************** }
  505. { ╒════════════════════════════════════════════════════════════════════════╕ }
  506. { │ ClearBox (x,y,xx,yy,at : Byte)                                         │ }
  507. { ╘════════════════════════════════════════════════════════════════════════╛ }
  508. procedure ClearBox (x,y,xx,yy,at:byte);
  509. { Original author: Orazio Czerwenka }
  510. var
  511.   aa,ax,ay,axx,ayy{,
  512.   b2}    :       byte;
  513. begin
  514.  
  515.   aa  := TextAttr;
  516.   ax  := Succ(Lo(WindMin));
  517.   ay  := Succ(Hi(WindMin));
  518.   axx := Succ(Lo(WindMax));
  519.   ayy := Succ(Hi(WindMax));
  520.  
  521.   window(x,y,xx,yy);
  522.   textattr:= at;
  523.   ClrScr;
  524.   window(ax,ay,axx,ayy);
  525.   textattr:= aa;
  526.   {
  527.  
  528.   for b2:= y to yy do begin
  529.     SetScreenPos(x,b2);
  530.     PutCharAttr(chr($20),at,xx-x+1);
  531.   end;
  532.   }
  533.  
  534. end;
  535.  
  536.  
  537. { ************************************************************************** }
  538.  
  539. procedure StdDisplayAt(x,y:word;at:byte;s:string);
  540. { Original author: Orazio Czerwenka }
  541. var
  542.   i     :       byte;
  543. begin
  544.   for i:= 1 to length(s) do begin
  545.     SetScreenPos(x,y);
  546.     PutCharAttr(s[i],at,1);
  547.     inc(x);
  548.   end;
  549. end;
  550.  
  551.  
  552. { ************************************************************************** }
  553.  
  554. procedure QuickDisplayAt(x,y:word;at:byte;s:string);
  555. { Original author: Sean Palmer
  556.   modifications Orazio Czerwenka }
  557. var
  558.   vidPtr : ^word;
  559.   cnter,
  560.   attrib : word;
  561. begin
  562.   attrib := swap(at);
  563.   CASE ActiveVideoPage OF
  564.     0: vidptr := ptr(VideoRAM,
  565.                 (MaxX * pred(Y) + pred(X)) SHL 1);
  566.     1: vidptr := ptr(VideoRAM,  VideoPageSize
  567.                   + (MaxX * pred(Y) + pred(X)) SHL 1
  568.             );
  569.     2: vidptr := ptr(VideoRAM,  VideoPageSize SHL 1
  570.                   + (MaxX * pred(Y) + pred(X)) SHL 1
  571.             );
  572.     4: vidptr := ptr(VideoRAM,  VideoPageSize SHL 2
  573.                   + (MaxX * pred(Y) + pred(X)) SHL 1
  574.             );
  575.   else vidptr := ptr(VideoRAM,  VideoPageSize*ActiveVideoPage
  576.                   + (MaxX * pred(Y) + pred(X)) SHL 1
  577.             );
  578.   end;
  579.   for cnter := 1 to length(s) do
  580.   begin
  581.     vidptr^ := attrib or byte (s[cnter]);
  582.     inc(vidptr);
  583.   end;
  584. end;
  585.  
  586.  
  587. { ************************************************************************** }
  588.  
  589. procedure FastDisplayAt(x,y:word;at:byte;s:string); assembler;
  590. { Original author: Jens Larsson }
  591. asm
  592.   dec   x
  593.   dec   y
  594.  
  595.   mov   ax,y
  596.   mov   cl,5
  597.   shl   ax,cl
  598.   mov   di,ax
  599.   mov   cl,2
  600.   shl   ax,cl
  601.   add   di,ax
  602.   shl   x,1
  603.   add   di,x
  604.  
  605.   mov   ax,VideoRAM {0b800h}     { 0b000h for mono }
  606.   mov   es,ax
  607.   xor   ch,ch
  608.   push  ds
  609.   lds   si,s
  610.   lodsb
  611.   mov   cl,al
  612.   mov   ah,at
  613.   jcxz  @@End
  614. @@L1:
  615.   lodsb
  616.   stosw
  617.   loop  @@L1
  618. @@End:
  619.   pop   ds
  620. end;
  621.  
  622.  
  623. { ************************************************************************** }
  624. { ╒════════════════════════════════════════════════════════════════════════╕ }
  625. { │ DisplayAt (x,y : Word; at : Byte; s : string)                          │ }
  626. { ╘════════════════════════════════════════════════════════════════════════╛ }
  627. procedure DisplayAt(x,y:word;at:byte;s:string);
  628. { Original author: Orazio Czerwenka }
  629. begin
  630.   OptDisplayAt(x,y,at,s);
  631. {  SetScreenPos(x+ord(s[0]),y);}
  632. end;
  633.  
  634.  
  635. { ************************************************************************** }
  636. { ╒════════════════════════════════════════════════════════════════════════╕ }
  637. { │ GetVideoDisplayCode : Byte                                             │ }
  638. { ╘════════════════════════════════════════════════════════════════════════╛ }
  639. function GetVideoDisplayCode: Byte; 
  640. { Original author: Orazio Czerwenka }
  641. begin
  642.   asm
  643.     mov   ax,      1A00h              { read video-display combination code }
  644.     int   10h
  645.     cmp   al,      1Ah                { ps/2 compatible ? }
  646.     je   @OK
  647.     xor   cl,      cl                 { to evaluate unsupported or unknown  }
  648.     mov   @result, cl
  649.     jmp  @END
  650.    @OK:
  651.     mov   @result, bl
  652.    @END:
  653.   end;
  654. end;
  655.  
  656.  
  657. { ************************************************************************** }
  658. { ╒════════════════════════════════════════════════════════════════════════╕ }
  659. { │ GetCardStr : NameStr                                                   │ }
  660. { ╘════════════════════════════════════════════════════════════════════════╛ }
  661. function GetCardStr: NameStr;
  662. { Original author: Orazio Czerwenka }
  663. begin
  664.   case GetVideoDisplayCode of
  665.     $00: GetCardStr:= 'none';      { no graphics adapter }
  666.     $01: GetCardStr:= 'mda';       { monochrome display adapter (= hgc ?) }
  667.     $02: GetCardStr:= 'cga_c';     { _c w/ colour, _m w/ monochrome display }
  668.     $04: GetCardStr:= 'ega_c';
  669.     $05: GetCardStr:= 'ega_m';
  670.     $06: GetCardStr:= 'pga_c';
  671.     $07: GetCardStr:= 'vga_m_a';   { _a w/ analag, _d w/ digital display }
  672.     $08: GetCardStr:= 'vga_c_a';
  673.     $0a: GetCardStr:= 'mcga_c_d';
  674.     $0b: GetCardStr:= 'mcga_m_a';
  675.     $0c: GetCardStr:= 'mcga_c_a';
  676.     $ff: GetCardStr:= 'unknown';
  677.   end;
  678. end;
  679.  
  680.  
  681. { ************************************************************************** }
  682. { ╒════════════════════════════════════════════════════════════════════════╕ }
  683. { │ VGACard : Boolean                                                      │ }
  684. { ╘════════════════════════════════════════════════════════════════════════╛ }
  685. function VGACard: boolean;      { returns true even if in ega mode }
  686. { Original author: Orazio Czerwenka }
  687. var                             { should work on none ps/2 as well }
  688.   regs  :       registers;      { for it directly goes the vgabios }
  689. begin
  690.   regs.ah:= $12;                { alternate function select }
  691.   regs.bl:= $34;                { cursor emulation, vga bios only }
  692.   regs.al:= $00;                { enable cursor emulation }
  693.   intr($10,regs);               
  694.   VGACard:= regs.al = $12;      { al = $12 if function supported }
  695. end;
  696.  
  697.  
  698. { ************************************************************************** }
  699. { ╒════════════════════════════════════════════════════════════════════════╕ }
  700. { │ EGAAvail : Boolean                                                     │ }
  701. { ╘════════════════════════════════════════════════════════════════════════╛ }
  702. Function EGAAvail : Boolean; Assembler;           { true for ega AND higher }
  703. { Original author: Orazio Czerwenka
  704.   modifications according to Max Maischein }
  705. Asm
  706.   push    bp
  707.   mov     ax, 1130h
  708.   xor     bh, bh
  709.   int     10h
  710.   mov     al, 0
  711.   cmc
  712.   adc     al, al
  713.   pop     bp
  714. End;
  715.  
  716.  
  717. { ************************************************************************** }
  718. { ╒════════════════════════════════════════════════════════════════════════╕ }
  719. { │ VGAAvail : Boolean                                                     │ }
  720. { ╘════════════════════════════════════════════════════════════════════════╛ }
  721. Function VGAAvail : Boolean;
  722. { Original author Orazio Czerwenka,
  723.   modifications according to Max Maischein }
  724. Assembler;
  725. {INT 10 - VIDEO - GET INDIVIDUAL PALETTE REGISTER (VGA)}
  726. Asm
  727.   mov     ax, 1007h
  728.   xor     bx, bx
  729.   int     10h
  730.   mov     al, 1
  731.   sbb     al, 0
  732.   ret
  733. End;
  734.  
  735.  
  736. { ************************************************************************** }
  737. { ╒════════════════════════════════════════════════════════════════════════╕ }
  738. { │ VGAMode : Boolean                                                      │ }
  739. { ╘════════════════════════════════════════════════════════════════════════╛ }
  740. function VGAMode: boolean;              { PS,VGA/MCGA }
  741. { Original author: Orazio Czerwenka }
  742. var
  743.  regs   :       registers;
  744. begin
  745.     regs.ah:= $1a;                      { video display combination }
  746.     regs.al:= $00;                      { read display combination code }
  747.     intr($10,regs);                     { do it babe, do it }
  748.     VGAMode:= (regs.al=$1a) and (regs.bl in [$07,$08])
  749.   end;                                  { al=$1a if function supported,
  750.                       bl=$07,$08 if in vga mode }
  751.  
  752.  
  753. { ************************************************************************** }
  754. { ╒════════════════════════════════════════════════════════════════════════╕ }
  755. { │ EGAMode : Boolean                                                      │ }
  756. { ╘════════════════════════════════════════════════════════════════════════╛ }
  757. function EGAMode: boolean;              { PS,VGA/MCGA }
  758. { Original author: Orazio Czerwenka }
  759. var
  760.  regs   :       registers;
  761. begin
  762.     regs.ah:= $1a;                      { video display combination }
  763.     regs.al:= $00;                      { read display combination code }
  764.     intr($10,regs);                     { do it babe, do it }
  765.     EGAMode:= (regs.al=$1a) and (regs.bl in [$04,$05])
  766.   end;                                  { al=$1a if function supported (PS,
  767.                       VGA/MCGA), bl=$07,$08 if vga (or
  768.                       mcga?) in egamode }
  769.  
  770.  
  771. { ************************************************************************** }
  772. { ╒════════════════════════════════════════════════════════════════════════╕ }
  773. { │ CRLF                                                                   │ }
  774. { ╘════════════════════════════════════════════════════════════════════════╛ }
  775. procedure CRLF; assembler;
  776. { Original author: Max Maischein }
  777. { modifications Orazio Czerwenka }
  778. asm
  779.   mov al, 0Dh
  780.   int 29h
  781.   mov al, 0Ah
  782.   int 29h
  783. end;
  784.  
  785.  
  786. { ************************************************************************** }
  787.  
  788. procedure QuickDisplay(at:byte;s:string);
  789. { Original author: Sean Palmer
  790.   modifications Orazio Czerwenka }
  791. var
  792.   vidPtr : ^word;
  793.   cnter,
  794.   attrib : word;
  795. begin
  796.   attrib := swap(at);
  797.   vidptr := ptr(VideoRAM,  VideoPageSize*ActiveVideoPage
  798.               + (MaxX * pred(GetY) + pred(GetX)) SHL 1
  799.               );
  800.   for cnter := 1 to length(s) do
  801.   begin
  802.     vidptr^ := attrib or byte(s[cnter]);
  803.     inc(vidptr);
  804.   end;
  805.   Cursorright(length(s));
  806. end;
  807.  
  808.  
  809. { ************************************************************************** }
  810.  
  811. procedure StdDisplay(at:byte;s:string);
  812. { Original author: Orazio Czerwenka }
  813. var
  814.   i     :       byte;
  815. begin
  816.   for i:= 1 to length(s) do begin
  817.     if GetX > MaxX then SetScreenPos(1,GetY+1);
  818.     PutCharAttr(s[i],at,1);
  819.     CursorRight(1);
  820.   end;
  821. end;
  822.  
  823.  
  824. { ************************************************************************** }
  825. { ╒════════════════════════════════════════════════════════════════════════╕ }
  826. { │ Display (at : Byte; s : String)                                        │ }
  827. { ╘════════════════════════════════════════════════════════════════════════╛ }
  828. procedure Display(at:byte;s:string);
  829. { Original author: Orazio Czerwenka }
  830. begin
  831.   {
  832.   quickDisplay(at,s);
  833.   }
  834.   textattr:= at;
  835.   write(s);
  836. end;
  837.  
  838.  
  839. { ************************************************************************** }
  840. { ╒════════════════════════════════════════════════════════════════════════╕ }
  841. { │ DisplayLn (at : Byte; s : String)                                      │ }
  842. { ╘════════════════════════════════════════════════════════════════════════╛ }
  843. procedure DisplayLn(at:byte;s:string);
  844. { Original author: Orazio Czerwenka }
  845. begin
  846.   Display(at,s);
  847.   CRLF;
  848. end;
  849.  
  850.  
  851. { ************************************************************************** }
  852.  
  853. procedure SetOptimalDisplay;
  854. { Original author: Orazio Czerwenka }
  855. begin
  856.   if PageFlipping then
  857.     OptDisplayAt:= QuickDisplayAt
  858.   else begin
  859.     if (MaxX = 80) and (ActiveVideoPage = 0)
  860.       then OptDisplayAt:= FastDisplayAt
  861.       else OptDisplayAt:= QuickDisplayAt;
  862.   end
  863. end;
  864.  
  865.  
  866. { ************************************************************************** }
  867. { ╒════════════════════════════════════════════════════════════════════════╕ }
  868. { │ EnablePageFlipping                                                     │ }
  869. { ╘════════════════════════════════════════════════════════════════════════╛ }
  870. procedure EnablePageFlipping;
  871. { Original author: Orazio Czerwenka }
  872. begin
  873.   PageFlipping:= true;
  874.   SetOptimalDisplay;
  875. end;
  876.  
  877.  
  878. { ************************************************************************** }
  879. { ╒════════════════════════════════════════════════════════════════════════╕ }
  880. { │ DisablePageFlipping                                                    │ }
  881. { ╘════════════════════════════════════════════════════════════════════════╛ }
  882. procedure DisablePageFlipping;
  883. { Original author: Orazio Czerwenka }
  884. begin
  885.   PageFlipping:= false;
  886.   SetOptimalDisplay;
  887. end;
  888.  
  889. { ************************************************************************** }
  890. { ╒════════════════════════════════════════════════════════════════════════╕ }
  891. { │ GetX : Byte                                                            │ }
  892. { ╘════════════════════════════════════════════════════════════════════════╛ }
  893. function GetX: byte;
  894. { Original author: Orazio Czerwenka }
  895. begin
  896.   GetX:= Succ(Mem[$40:$50+ActiveVideoPage shl 1]);       { tested for VGA }
  897. end;
  898.  
  899. { ************************************************************************** }
  900. { ╒════════════════════════════════════════════════════════════════════════╕ }
  901. { │ GetY : Byte                                                            │ }
  902. { ╘════════════════════════════════════════════════════════════════════════╛ }
  903. function GetY: byte;
  904. { Original author: Orazio Czerwenka }
  905. begin
  906.   GetY := Succ(Mem[$40:$51+ActiveVideoPage shl 1]);      { tested for VGA }
  907.   if (not VGAAvail) and EGAAvail
  908.     then GetY:= Mem[$40:$51+ActiveVideoPage shl 1];      { untested for EGA }
  909. end;
  910.  
  911. { ************************************************************************** }
  912. { ╒════════════════════════════════════════════════════════════════════════╕ }
  913. { │ Delay (ms : Word)                                                      │ }
  914. { ╘════════════════════════════════════════════════════════════════════════╛ }
  915.  
  916. procedure Delay(ms : Word); Assembler;
  917. { SWAG Support Team }
  918. Asm {machine independent Delay function}
  919.   mov ax, 1000;
  920.   mul ms;
  921.   mov cx, dx;
  922.   mov dx, ax;
  923.   mov ah, $86;
  924.   int $15;
  925. end;
  926.  
  927. { ************************************************************************** }
  928. { ╒════════════════════════════════════════════════════════════════════════╕ }
  929. { │ GetVideoMode : Word                                                    │ }
  930. { ╘════════════════════════════════════════════════════════════════════════╛ }
  931. function GetVideoMode: word;
  932. { Original author: Orazio Czerwenka }
  933. var
  934.   regs  : registers;
  935. begin
  936.   regs.ah:= $0F;
  937.   intr($10,regs);
  938.   GetVideoMode:= regs.al;
  939. end;
  940.  
  941. procedure SetVideoMode(Mode:Word);
  942. { Original author: Orazio Czerwenka,
  943.   modified by Paul Schubert }
  944. begin
  945.   if Mode <> CurrentVideoMode then
  946.     LastVideoMode:= CurrentVideoMode;
  947.   asm
  948.     mov ax,mode
  949.     int 10h
  950.   end;
  951.   ReInitFCRT;
  952. end;
  953.  
  954. { ************************************************************************** }
  955. { ╒════════════════════════════════════════════════════════════════════════╕ }
  956. { │ SetActiveVideoPage (page : Byte)                                       │ }
  957. { ╘════════════════════════════════════════════════════════════════════════╛ }
  958. procedure SetActiveVideoPage(page:byte);
  959. { Original author: Orazio Czerwenka
  960.   modified by Paul Schubert }
  961. begin
  962.   if PageFlipping then begin
  963.     ActiveVideoPage:= page;
  964.     windmin := wmi[page];
  965.     windmax := wma[page];
  966.   end;
  967. end;
  968.  
  969. { ************************************************************************** }
  970. { ╒════════════════════════════════════════════════════════════════════════╕ }
  971. { │ SetVisualVideoPage (page : Byte)                                       │ }
  972. { ╘════════════════════════════════════════════════════════════════════════╛ }
  973. procedure SetVisualVideoPage(page:byte);
  974. { Original author: Orazio Czerwenka }
  975. begin
  976.   if PageFlipping then begin
  977.     asm
  978.       mov  AH, 05h                  { set active page }
  979.       mov  AL, page                 { page number }
  980.       int  10h
  981.     end;
  982.     VisualVideoPage:= page;
  983.     Mem[$40:$62]:= VisualVideoPage;
  984.   end;
  985. end;
  986.  
  987.  
  988. { ************************************************************************** }
  989. { ╒════════════════════════════════════════════════════════════════════════╕ }
  990. { │ SetBlinkBit (b: Boolean)                                               │ }
  991. { ╘════════════════════════════════════════════════════════════════════════╛ }
  992. procedure SetBlinkBit (b:boolean);       { supposed to work on HGC/EGA/VGA }
  993. { Posted by Christian Proehl
  994.   05/24/1994 PASCAL.GER, modifications Orazio Czerwenka }
  995. const
  996.   HGC = 7;
  997. var
  998.   PortAddr : word;
  999.   regs     : registers;
  1000. begin
  1001.   regs.AX:= $1003;
  1002.   if GetVideoMode = HGC
  1003.     then PortAddr:= $3B8
  1004.     else PortAddr:= $3D8;
  1005.   if b then begin
  1006.     regs.BL:= $01;
  1007.     intr($10,regs);
  1008.     if regs.AL = $03 then Port[PortAddr]:= Mem[$40:$65] or $20;
  1009.   end
  1010.   else begin
  1011.     regs.BL:= $00;
  1012.     intr($10,regs);
  1013.     if regs.AL = $03 then Port[PortAddr]:= Mem[$40:$65] and $DF;
  1014.   end;
  1015. end;
  1016.  
  1017.  
  1018. { ************************************************************************** }
  1019. { ╒════════════════════════════════════════════════════════════════════════╕ }
  1020. { │ EnableLightBackground (b : Boolean)                                    │ }
  1021. { ╘════════════════════════════════════════════════════════════════════════╛ }
  1022. procedure EnableLightBackground (b:boolean);       { supposed to work on MDA/EGA/VGA }
  1023. { Posted by Christian Proehl
  1024.   05/24/1994 PASCAL.GER, modifications Orazio Czerwenka }
  1025. const
  1026.   MDA = 7;
  1027. var
  1028.   PortAddr : word;
  1029.   regs     : registers;
  1030. begin
  1031.   regs.AX:= $1003;
  1032.   if GetVideoMode = MDA
  1033.     then PortAddr:= $3B8
  1034.     else PortAddr:= $3D8;
  1035.   if b then begin
  1036.     regs.BL:= $00;
  1037.     intr($10,regs);
  1038.     if regs.AL = $03 then Port[PortAddr]:= Mem[$40:$65] and $DF;
  1039.   end
  1040.   else begin
  1041.     regs.BL:= $01;
  1042.     intr($10,regs);
  1043.     if regs.AL = $03 then Port[PortAddr]:= Mem[$40:$65] or $20;
  1044.   end;
  1045. end;
  1046.  
  1047.  
  1048. { ************************************************************************** }
  1049. { ╒════════════════════════════════════════════════════════════════════════╕ }
  1050. { │ ScrOn                                                                  │ }
  1051. { ╘════════════════════════════════════════════════════════════════════════╛ }
  1052. procedure ScrOn;
  1053.   procedure VGAScrOn; assembler;
  1054.   { Original author: Max Maischein, CRT2 }
  1055.   asm
  1056.     mov  bl, 36h
  1057.     mov  ax, 1200h
  1058.     int  10h
  1059.   end;
  1060. begin
  1061.   if VGACard then VGAScrOn;
  1062. end;
  1063.  
  1064.  
  1065. { ************************************************************************** }
  1066. { ╒════════════════════════════════════════════════════════════════════════╕ }
  1067. { │ ScrOff                                                                 │ }
  1068. { ╘════════════════════════════════════════════════════════════════════════╛ }
  1069. procedure ScrOff;
  1070.   procedure VGAScrOff; assembler;
  1071.   { Original author: Max Maischein, CRT2 }
  1072.   asm
  1073.     mov  bl, 36h
  1074.     mov  ax, 1201h
  1075.     int  10h
  1076.   end;
  1077. begin
  1078.   if VGACard then VGAScrOff;
  1079. end;
  1080.  
  1081.  
  1082. { ************************************************************************** }
  1083.  
  1084. procedure InitAtStart;
  1085. begin
  1086.   StartVideoPage  := Mem[$40:$62];
  1087.   VisualVideoPage := StartVideoPage;
  1088.   ActiveVideoPage := VisualVideoPage;
  1089.   StartVideoMode  := CurrentVideoMode;
  1090.   LastVideoMode   := StartVideoMode;
  1091. end;
  1092.  
  1093. { ************************************************************************** }
  1094. { ╒════════════════════════════════════════════════════════════════════════╕ }
  1095. { │ ReInitFCRT                                                             │ }
  1096. { ╘════════════════════════════════════════════════════════════════════════╛ }
  1097. procedure ReInitFCrt;
  1098. { Original author: Orazio Czerwenka }
  1099. begin
  1100.  
  1101.   if CurrentVideoMode = 7
  1102.     then VideoRAM:= $B000
  1103.     else VideoRAM:= $B800;
  1104.  
  1105.   MaxY:= Mem[$40:$84];
  1106.   if VGACard then inc(MaxY);
  1107.   MaxX:= Mem[$40:$4A];
  1108.   SetOptimalDisplay;
  1109.  
  1110.   REINITFCONDRV;
  1111.   ASSIGNFCRT(OUTPUT);
  1112.   REWRITE(OUTPUT);
  1113. end;
  1114.  
  1115.  
  1116. { ************************************************************************** }
  1117. { ╒════════════════════════════════════════════════════════════════════════╕ }
  1118. { │ InitFCRT                                                               │ }
  1119. { ╘════════════════════════════════════════════════════════════════════════╛ }
  1120. procedure InitFCRT;
  1121. begin
  1122.   InitAtStart;
  1123.   ReInitFCRT;
  1124. end;
  1125.  
  1126. {$IFOPT O-}
  1127. begin
  1128.   InitFCRT;
  1129. {$ENDIF}
  1130. end.
  1131.  
  1132.